www.gusucode.com > 云网互动影视系统(12套模版和资源联盟) 6.2 > 云网互动影视系统(12套模版和资源联盟) 6.2.4/免费版/Admin/Collect/Collecting.asp
<%Server.ScriptTimeOut=9999%>
<html>
<head>
<META content=ywnt,云网互动影视管理系统 name=keywords>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>云网互动影视6.0--采集管理</title>
<LINK href="../css/css.css" type=text/css rel=stylesheet>
</head>
<BODY leftMargin=0 topMargin=0 scroll=yes MARGINHEIGHT="0" MARGINWIDTH="0">
<!--#include file="Conn.asp" -->
<!--#include file="../../Conn.asp" -->
<!--#include file="../YWNT_TMS_Inc/YWNT_TMS_Function.asp" -->
<!--#include file="Inc/Function.asp" -->
<!--#include file="../../Function/clsCache.asp"-->
<%
'===================================================================================================================
'软件名称：云网影视管理系统
'Copyright (C) 2002-2007 ywnt.net All rights reserved.
'产品咨询QQ：489234,2813712
'程序版权：云网互动科技有限公司
'程序开发：云网互动科技有限公司
'官方网站：http://www.ywnt.net
'郑重声明:
' 1、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
' 2、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
' 3、云网互动科技有限公司保留此软件的法律追究权利
'===================================================================================================================
Colledt_ListNum=Request.QueryString("ListNum")
Colledt_MovieNum=Request.QueryString("MovieNum")
sb=Request.QueryString("sb")
cg=Request.QueryString("cg")
txt=""
ErrMsg=""
ListEnd=0
if Colledt_ListNum="" then
Colledt_ListNum=0
end if
if Colledt_MovieNum="" then
Colledt_MovieNum=0
end if
if sb="" and cg="" then
Call CheckLogin("Collect")
set Rs=Connx.execute("update Collect_Class set CollectTime=now() where id="&Request.QueryString("id"))
call DelCache()
sb=0
cg=0
Call AddLog("采集栏目采集",9)
end if
dim cjlms,myCache
set myCache=new ywnt_clsCache
myCache.name="MovieCollect"
if myCache.valid then
cjlms=myCache.value
else
set rs=server.createobject(YWNT_TMS_RS)
sql="select ID,CollectName,selEncoding,ListPaingType,ListPaingStr,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3,Script_Iframe,Script_Object,Script_Script,Script_Div,Script_Class,Script_Table,Script_Tr,Script_Span,Script_Img,Script_Font,Script_A,Script_Html,Script_Td,SaveFiles,CollecOrder,RepeatCollect,LsString,LoString,HsString,HoString,Htitle,Ftitle,Hname,Fname,Htupian,Ftupian,ClassType,CollectClass,HClass,FClass,RegionType,CollectRegion,HRegion,FRegion,Hcontent,Fcontent,ScopeOn,Hscope,Fscope,Hweburl,Fweburl,UrlType,Rurl,Reurl,Hpurl,Fpurl from Collect_Class where id = "&Request.QueryString("id")
rs.open sql,connx,1,1
If Not rs.Eof Then
cjlms=rs.GetRows()
End If
rs.Close
Set rs=Nothing
myCache.add cjlms,dateadd("n",100,now)
end if
set myCache=nothing
ID=cjlms(0,0)
CollectName=cjlms(1,0)
selEncoding=cjlms(2,0)
ListPaingType=cjlms(3,0)
ListPaingStr=cjlms(4,0)
ListPaingStr2=cjlms(5,0)
ListPaingID1=cjlms(6,0)
ListPaingID2=cjlms(7,0)
ListPaingStr3=cjlms(8,0)
Script_Iframe=cjlms(9,0)
Script_Object=cjlms(10,0)
Script_Script=cjlms(11,0)
Script_Div=cjlms(12,0)
Script_Class=cjlms(13,0)
Script_Table=cjlms(14,0)
Script_Tr=cjlms(15,0)
Script_Span=cjlms(16,0)
Script_Img=cjlms(17,0)
Script_Font=cjlms(18,0)
Script_A=cjlms(19,0)
Script_Html=cjlms(20,0)
Script_Td=cjlms(21,0)
SaveFiles=cjlms(22,0)
CollecOrder=cjlms(23,0)
RepeatCollect=cjlms(24,0)
LsString=cjlms(25,0)
LoString=cjlms(26,0)
HsString=cjlms(27,0)
HoString=cjlms(28,0)
Htitle=cjlms(29,0)
Ftitle=cjlms(30,0)
Hname=cjlms(31,0)
Fname=cjlms(32,0)
Htupian=cjlms(33,0)
Ftupian=cjlms(34,0)
ClassType=cjlms(35,0)
CollectClass=cjlms(36,0)
HClass=cjlms(37,0)
FClass=cjlms(38,0)
RegionType=cjlms(39,0)
CollectRegion=cjlms(40,0)
HRegion=cjlms(41,0)
FRegion=cjlms(42,0)
Hcontent=cjlms(43,0)
Fcontent=cjlms(44,0)
ScopeOn=cjlms(45,0)
Hscope=cjlms(46,0)
Fscope=cjlms(47,0)
Hweburl=cjlms(48,0)
Fweburl=cjlms(49,0)
UrlType=cjlms(50,0)
Rurl=cjlms(51,0)
Reurl=cjlms(52,0)
Hpurl=cjlms(53,0)
Fpurl=cjlms(54,0)
Select Case ListPaingType
Case 0
If Colledt_ListNum<1 Then
ListUrl=ListPaingStr
Else
ListEnd=1
End if
Case 1,3
If CollecOrder=1 then
If (ListpaingID2-Colledt_ListNum)<ListPaingID1 or (ListpaingID2-Colledt_ListNum)<0 Then
ListEnd=1
Else
ListUrl=Replace(ListPaingStr2,"{$ID}",(ListpaingID2-Colledt_ListNum))
End if
Else
If (ListPaingID1+Colledt_ListNum)>ListPaingID2 Then
ListEnd=1
Else
ListUrl=Replace(ListPaingStr2,"{$ID}",(ListPaingID1+Colledt_ListNum))
End If
End If
Case 2
ListArray=Split(ListPaingStr3,"|")
If (Colledt_ListNum)>CInt(Ubound(ListArray)) Then
ListEnd=1
Else
ListUrl=ListArray(Colledt_ListNum)
End If
End Select
Select Case ListEnd
Case 1
call DelCache()
txt=""&txt&"采集完成"
Case else
call Collecting(ListUrl,Colledt_MovieNum)
response.write"<meta http-equiv=""refresh"" content=""0;url=Collecting.asp?id="&id&"&ListNum="&Colledt_ListNum&"&MovieNum="&Colledt_MovieNum&"&sb="&sb&"&cg="&cg&""">"
end Select
sub Collecting(Url,MovieNumID)
On Error Resume Next
ListCode=GetHttpPage(Url,selEncoding)
Select Case ListCode
Case False
ErrMsg="在获取:" & Url & "网页源码时发生错误"
call WriteErrMsg(ErrMsg)
exit sub
End Select
Select Case ListPaingType
Case 3
Colledt_ListNum=Colledt_ListNum+1
NewsCode=ListCode
UrlTest=Url
Case Else
If Session(ID&Colledt_ListNum)="" Then
ListCode=GetBody(ListCode,LsString,LoString)
NewsArrayCode=GetArray(ListCode,HsString,HoString)
If NewsArrayCode=False Then
txt=txt&"<font color=red><b>在获取链接列表时出错</b></font>"
sb=sb+1
exit sub
End If
Session(ID&Colledt_ListNum)=NewsArrayCode
Session(ID&Colledt_ListNum-1)=""
End If
NewsArray=Split(Session(ID&Colledt_ListNum),"$Array$")
If CInt(Ubound(NewsArray))-MovieNumID<=0 Then
Colledt_ListNum=Colledt_ListNum+1
Colledt_MovieNum=0
else
Colledt_MovieNum=Colledt_MovieNum+1
End If
UrlTest=DefiniteUrl(NewsArray(MovieNumID),Url)
NewsCode=GetHttpPage(UrlTest,selEncoding)
End Select
If NewsCode=False then
txt=txt&"<font color=red><b>在获取内容页时出错。</b></font>"
sb=sb+1
exit sub
Else
title=FilterScript(GetBody(NewsCode,Htitle,Ftitle))
namex=FilterScript(GetBody(NewsCode,Hname,Fname))
tupian=GetBody(NewsCode,Htupian,Ftupian)
if ClassType=1 then
typeid=FilterScript(GetBody(NewsCode,HClass,FClass))
typeidname=typeid
else
typeid=CollectClass
typeidname=CollectClassName(typeid)
end if
if RegionType=1 then
region=FilterScript(GetBody(NewsCode,HRegion,FRegion))
regionname=region
else
region=CollectRegion
regionname=CollectRegionName(region)
end if
content=FilterScript(GetBody(NewsCode,Hcontent,Fcontent))
if ScopeOn=1 then
Urlscope=GetBody(NewsCode,Hscope,Fscope)
weburl=GetArray(Urlscope,Hweburl,Fweburl)
else
weburl=GetArray(NewsCode,Hweburl,Fweburl)
end if
txt="来源地址："&UrlTest&"<br>电影名称："&title&"<br>演员："&namex&"<br>图片："&tupian&"<br>栏目："&typeidname&"<br>地区："®ionname&"<br>介绍："&content&"<br>"
If weburl=False Then
txt=""&txt&"<font color=red><b>在获取播放列表链接时出错。</b></font>"
sb=sb+1
exit sub
else
if CheckMovieName(title)>0 and RepeatCollect=1 then
sburl=1
else
set rs=server.createobject(YWNT_TMS_RS)
sql="select id,UrlTest,title,name,tupian,typeid,region,content,ClassName,TimeDate,ClassType,RegionType from movie where UrlTest='"&UrlTest&"' order by ID desc"
rs.Open sql,connx,1,3
if not rs.eof then
sburl=1
else
cg=cg+1
rs.addnew
rs("UrlTest")=UrlTest
rs("title")=title
rs("name")=namex
rs("tupian")=getHTTPimg(tupian,UrlTest)
rs("typeid")=typeid
rs("region")=region
rs("content")=content
rs("ClassName")=CollectName
rs("TimeDate")=now()
rs("ClassType")=ClassType
rs("RegionType")=RegionType
rs.update
movieid=rs("id")
end if
rs.close
set rs=nothing
end if
if sburl=1 then
txt=""&txt&"<font color=red><b>采集失败 数据库中已经有此记录重复采集</b></font>"
sb=sb+1
exit sub
else
webArray=Split(weburl,"$Array$")
For i=0 To Ubound(webArray)
Select Case UrlType
Case 1
Keyurl = Split(Rurl,"[变量]",-1,1)
urli=GetBody(webArray(i),Keyurl(0),Keyurl(1))
if urli=False then
Exit For
end if
WebTest=Replace(Reurl,"[变量]",urli)
WebTestx=DefiniteUrl(WebTest,UrlTest)
Case else
WebTestx=DefiniteUrl(webArray(i),UrlTest)
End Select
webCode=GetHttpPage(WebTestx,selEncoding)
url=GetBody(webCode,Hpurl,Fpurl)
txt=""&txt&"播放列表:"&WebTestx&"<br>影片地址："&url&"<br>"
connx.Execute("insert into url(url,nameid,weburl) values('"&url&"','"&movieid&"','"&WebTestx&"')")
Next
end if
End If
End If
end sub
Function FilterScript(Content)
If Script_Iframe=1 Then
Content=ScriptHtml(Content,"Iframe",1)
End If
If Script_Object=1 Then
Content=ScriptHtml(Content,"Object",2)
End If
If Script_Script=1 Then
Content=ScriptHtml(Content,"Script",2)
End If
If Script_Div=1 Then
Content=ScriptHtml(Content,"Div",3)
End If
If Script_Table=1 Then
Content=ScriptHtml(Content,"table",3)
End If
If Script_Tr=1 Then
Content=ScriptHtml(Content,"tr",3)
End If
If Script_Td=1 Then
Content=ScriptHtml(Content,"td",3)
End If
If Script_Span=1 Then
Content=ScriptHtml(Content,"Span",3)
End If
If Script_Img=1 Then
Content=ScriptHtml(Content,"Img",3)
End If
If Script_Font=1 Then
Content=ScriptHtml(Content,"Font",3)
End If
If Script_A=1 Then
Content=ScriptHtml(Content,"A",3)
End If
If Script_Html=1 Then
Content=noHtml(Content)
End If
FilterScript=Content
End Function
sub WriteErrMsg(ErrMsg)
strErr=strErr & "<table cellpadding=3 cellspacing=1 border=0 width=400 align=center class='table'>" & vbcrlf
strErr=strErr & " <tr class='xingmu'><td height='22'><strong>错误信息</strong></td></tr>" & vbcrlf
strErr=strErr & " <tr class='hback'><td height='100' valign='top'><b>产生错误的可能原因：</b>" & ErrMsg &"</td></tr>" & vbcrlf
strErr=strErr & "</table>" & vbcrlf
response.write strErr
response.end
end sub
sub DelCache()
set myCache=new ywnt_clsCache
myCache.name="MovieCollect"
Call myCache.clean()
Set myCache=Nothing
Session(ID&Colledt_ListNum)=""
end sub
call connxclose()%>
<table width="98%" border="0" align="center" cellpadding="3" cellspacing="1" class=table>
<tr>
<td class=xingmu>采集统计</td>
</tr>
<tr>
<td class="hback">采集统计：成功采集--<%=cg%> 条记录，失败--<%=sb%> 条</td>
</tr>
</table>
<table width="98%" border="0" align="center" cellpadding="2" cellspacing="1" class=table>
<tr>
<td class="hback"><%=txt%></td>
</tr>
</table>